setup

rr rm(list = ls()) library(tidyverse) library(ggplot2) library(car) library(scam)

download data

rr if (file.exists(-2020-06-20/openpowerlifting-2020-06-20.csv)){ data.working <- read.csv(-2020-06-20/openpowerlifting-2020-06-20.csv) } else { download.file(://github.com/sstangl/openpowerlifting-static/raw/gh-pages/openpowerlifting-latest.zip, -latest.zip) unzip(-latest.zip)

data.working <- read.csv(-2020-06-20/openpowerlifting-2020-06-20.csv) }

filter data

rr data.working <- data.working %>% filter(Event == , Equipment == , !is.na(Age), !is.na(BodyweightKg), !is.na(TotalKg), ParentFederation == )

creating features

rr data.working <- data.working %>% mutate(AgeBucket = as.factor(case_when( Age <= 19 ~ , Age >= 20 & Age <= 23 ~ , Age >= 24 & Age <= 35 ~ , Age >= 36 ~ , TRUE ~ ))) %>% mutate(Federation = as.factor(Federation)) # Adding weightclass data.working\(WeightclassKg_Calc <- \error\ data.working[data.working\)Sex == ,_Calc] <- data.working %>% filter(Sex == ) %>% transmute(WeightclassKg_Calc = as.character(cut(BodyweightKg, c(0,53,59,66,74,83,93,105,120,9999)))) data.working[data.working\(Sex == \F\,\WeightclassKg_Calc\] <- data.working %>% filter(Sex == \F\) %>% transmute(WeightclassKg_Calc = as.character(cut(BodyweightKg, c(0,43,47,52,57,63,72,84,9999)))) data.working\)WeightclassKg_Calc <- as.factor(data.working$WeightclassKg_Calc)

rr weightclasses <- unique(data.working$WeightclassKg_Calc)

intra-weightclass scam

monotone increasing concave –> bs = “micv”

rr for (each in weightclasses){

Warning messages:
1: In readChar(file, size, TRUE) : truncating string with embedded nuls
2: In readChar(file, size, TRUE) : truncating string with embedded nuls
3: In readChar(file, size, TRUE) : truncating string with embedded nuls
4: In readChar(file, size, TRUE) : truncating string with embedded nuls
5: In readChar(file, size, TRUE) : truncating string with embedded nuls

rr

df_tmp <- data.working %>% filter(WeightclassKg_Calc == each) %>% select(TotalKg, BodyweightKg)

scam_tmp <- scam(data = df_tmp, TotalKg ~ s(BodyweightKg, bs = ))

df_tmp$scam_predict <- predict(scam_tmp)

print(ggplot(df_tmp) + geom_point(aes(x = BodyweightKg, y = TotalKg)) + geom_line(aes(x = BodyweightKg, y = scam_predict), color = , size = 2) + ggtitle(paste(each, : Raw with GAM)))

data.working[data.working\(WeightclassKg_Calc == each, \TotalKg_scam\] <- data.working[data.working\)WeightclassKg_Calc == each, ] / df_tmp$scam_predict

print(ggplot(data.working %>% filter(WeightclassKg_Calc == each)) + geom_point(aes(x = BodyweightKg, y = TotalKg_scam)) + ggtitle(paste(each, : Transformed))) }

rr ggplot(data.working %>% filter(Sex == )) + geom_point(aes(x = BodyweightKg, y = TotalKg_scam))

rr ggplot(data.working %>% filter(Sex == )) + geom_point(aes(x = BodyweightKg, y = TotalKg_scam))

box-cox

rr box_cox_df <- matrix(ncol = 2, nrow = length(unique(data.working\(WeightclassKg_Calc))) # dataframe of optimal lambdas for (x in 1:length(weightclasses)){ tmp <- data.working %>% filter(WeightclassKg_Calc == weightclasses[x]) box_cox_df[x,1] <- as.character(weightclasses[x]) box_cox_df[x,2] <- powerTransform(tmp\)TotalKg_scam)\(lambda } box_cox_df <- as.data.frame(box_cox_df) colnames(box_cox_df) <- c(\WeightclassKg\, \lambda\) box_cox_df\)WeightclassKg <- as.character(box_cox_df\(WeightclassKg) box_cox_df\)lambda <- as.numeric(box_cox_df\(lambda) box_cox_df ``` ```r # applying box-cox w/ said optimal lambda data.working\)SCORE <- 0 for (each in weightclasses){ x = data.working[data.working\(WeightclassKg_Calc == each,\TotalKg_scam\] data.working[data.working\)WeightclassKg_Calc == each,] <- bcPower(x,box_cox_df[box_cox_df\(WeightclassKg == each,\lambda\]) } # divide by mean for (each in weightclasses){ data.working[data.working\)WeightclassKg_Calc == each,] <- scale(data.working[data.working$WeightclassKg_Calc == each,]) }

visualize box cox results

rr # individual weight classes for (each in weightclasses){ tmp <- data.working %>% filter(WeightclassKg_Calc == each) %>% select(SCORE)

gg <- ggplot(tmp) + geom_density(aes(x = SCORE)) + ggtitle(each)

print(gg) }

rr # male / female for (each in c(, )){ print(ggplot(data.working %>% filter(Sex == each)) + geom_point((aes(x = BodyweightKg, y = SCORE))) + ggtitle(paste(=,each))) }

Top Men & Women

rr data.working %>% arrange(desc(SCORE)) %>% filter(Sex == ) %>% filter(row_number() <11) r data.working %>% arrange(desc(SCORE)) %>% filter(Sex == ) %>% filter(row_number() <11)

rr NA

Validation: Deciles

# test out other scores...
LS0tCnRpdGxlOiAib3Blbi1wb3dlcmxpZnRpbmctR0FNIgphdXRob3I6ICJKb2huIE15c2xpbnNraSIKb3V0cHV0OiBodG1sX25vdGVib29rCi0tLQojIHNldHVwCmBgYHtyIHNldHVwLCByZXN1bHRzID0gJ2hpZGUnLCB3YXJuaW5nPUZBTFNFfQpybShsaXN0ID0gbHMoKSkKCmxpYnJhcnkodGlkeXZlcnNlKQpsaWJyYXJ5KGdncGxvdDIpCmxpYnJhcnkoY2FyKQpsaWJyYXJ5KHNjYW0pCmBgYAoKIyBkb3dubG9hZCBkYXRhCmBgYHtyIGRvd25sb2FkLCByZXN1bHRzID0gJ2hpZGUnLCB3YXJuaW5nPUZBTFNFfQppZiAoZmlsZS5leGlzdHMoIm9wZW5wb3dlcmxpZnRpbmctMjAyMC0wNi0yMC9vcGVucG93ZXJsaWZ0aW5nLTIwMjAtMDYtMjAuY3N2IikpewogIGRhdGEud29ya2luZyA8LSByZWFkLmNzdigib3BlbnBvd2VybGlmdGluZy0yMDIwLTA2LTIwL29wZW5wb3dlcmxpZnRpbmctMjAyMC0wNi0yMC5jc3YiKQp9IGVsc2UgewogIGRvd25sb2FkLmZpbGUoImh0dHBzOi8vZ2l0aHViLmNvbS9zc3RhbmdsL29wZW5wb3dlcmxpZnRpbmctc3RhdGljL3Jhdy9naC1wYWdlcy9vcGVucG93ZXJsaWZ0aW5nLWxhdGVzdC56aXAiLAogICAgICAgICAgICAgICJvcGVucG93ZXJsaWZ0aW5nLWxhdGVzdC56aXAiKQogIHVuemlwKCJvcGVucG93ZXJsaWZ0aW5nLWxhdGVzdC56aXAiKQogIAogIGRhdGEud29ya2luZyA8LSByZWFkLmNzdigib3BlbnBvd2VybGlmdGluZy0yMDIwLTA2LTIwL29wZW5wb3dlcmxpZnRpbmctMjAyMC0wNi0yMC5jc3YiKQp9CmBgYAoKIyBmaWx0ZXIgZGF0YQpgYGB7ciBmaWx0ZXJ9CmRhdGEud29ya2luZyA8LSBkYXRhLndvcmtpbmcgJT4lCiAgZmlsdGVyKEV2ZW50ID09ICJTQkQiLAogICAgICAgICBFcXVpcG1lbnQgPT0gIlJhdyIsCiAgICAgICAgICFpcy5uYShBZ2UpLAogICAgICAgICAhaXMubmEoQm9keXdlaWdodEtnKSwKICAgICAgICAgIWlzLm5hKFRvdGFsS2cpLAogICAgICAgICBQYXJlbnRGZWRlcmF0aW9uID09ICJJUEYiKQpgYGAKCiMgY3JlYXRpbmcgZmVhdHVyZXMKYGBge3IgZmVhdHVyZXN9CmRhdGEud29ya2luZyA8LSBkYXRhLndvcmtpbmcgJT4lCiAgbXV0YXRlKEFnZUJ1Y2tldCA9IGFzLmZhY3RvcihjYXNlX3doZW4oCiAgICAgICAgIEFnZSA8PSAxOSB+ICJZb3VuZ2VyIiwKICAgICAgICAgQWdlID49IDIwICYgQWdlIDw9IDIzIH4gIkp1bmlvciIsCiAgICAgICAgIEFnZSA+PSAyNCAmIEFnZSA8PSAzNSB+ICJPcGVuIiwKICAgICAgICAgQWdlID49IDM2IH4gIk1hc3RlciIsCiAgICAgICAgIFRSVUUgfiAiRVJST1IiKSkpICU+JQogIG11dGF0ZShGZWRlcmF0aW9uID0gYXMuZmFjdG9yKEZlZGVyYXRpb24pKQoKCiMgQWRkaW5nIHdlaWdodGNsYXNzCmRhdGEud29ya2luZyRXZWlnaHRjbGFzc0tnX0NhbGMgPC0gImVycm9yIgoKZGF0YS53b3JraW5nW2RhdGEud29ya2luZyRTZXggPT0gIk0iLCJXZWlnaHRjbGFzc0tnX0NhbGMiXSA8LSBkYXRhLndvcmtpbmcgJT4lIAogIGZpbHRlcihTZXggPT0gIk0iKSAlPiUKICB0cmFuc211dGUoV2VpZ2h0Y2xhc3NLZ19DYWxjID0gYXMuY2hhcmFjdGVyKGN1dChCb2R5d2VpZ2h0S2csCiAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICBjKDAsNTMsNTksNjYsNzQsODMsOTMsMTA1LDEyMCw5OTk5KSkpKQoKZGF0YS53b3JraW5nW2RhdGEud29ya2luZyRTZXggPT0gIkYiLCJXZWlnaHRjbGFzc0tnX0NhbGMiXSA8LSBkYXRhLndvcmtpbmcgJT4lIAogIGZpbHRlcihTZXggPT0gIkYiKSAlPiUKICB0cmFuc211dGUoV2VpZ2h0Y2xhc3NLZ19DYWxjID0gYXMuY2hhcmFjdGVyKGN1dChCb2R5d2VpZ2h0S2csCiAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICBjKDAsNDMsNDcsNTIsNTcsNjMsNzIsODQsOTk5OSkpKSkKCmRhdGEud29ya2luZyRXZWlnaHRjbGFzc0tnX0NhbGMgPC0gYXMuZmFjdG9yKGRhdGEud29ya2luZyRXZWlnaHRjbGFzc0tnX0NhbGMpCmBgYAoKYGBge3J9CndlaWdodGNsYXNzZXMgPC0gdW5pcXVlKGRhdGEud29ya2luZyRXZWlnaHRjbGFzc0tnX0NhbGMpCmBgYAoKCiMgaW50cmEtd2VpZ2h0Y2xhc3Mgc2NhbQojIyBtb25vdG9uZSBpbmNyZWFzaW5nIGNvbmNhdmUgLS0+IGJzID0gIm1pY3YiCmBgYHtyfQpmb3IgKGVhY2ggaW4gd2VpZ2h0Y2xhc3Nlcyl7CiAgCiAgZGZfdG1wIDwtIGRhdGEud29ya2luZyAlPiUKICAgIGZpbHRlcihXZWlnaHRjbGFzc0tnX0NhbGMgPT0gZWFjaCkgJT4lCiAgICBzZWxlY3QoVG90YWxLZywgQm9keXdlaWdodEtnKQogIAogIHNjYW1fdG1wIDwtIHNjYW0oZGF0YSA9IGRmX3RtcCwKICAgICAgICAgICAgICAgICAgIFRvdGFsS2cgfiBzKEJvZHl3ZWlnaHRLZywgYnMgPSAibXBpIikpCiAgCiAgZGZfdG1wJHNjYW1fcHJlZGljdCA8LSBwcmVkaWN0KHNjYW1fdG1wKQogIAogIHByaW50KGdncGxvdChkZl90bXApICsKICAgIGdlb21fcG9pbnQoYWVzKHggPSBCb2R5d2VpZ2h0S2csIHkgPSBUb3RhbEtnKSkgKwogICAgZ2VvbV9saW5lKGFlcyh4ID0gQm9keXdlaWdodEtnLCB5ID0gc2NhbV9wcmVkaWN0KSwgY29sb3IgPSAiYmx1ZSIsIHNpemUgPSAyKSArCiAgICBnZ3RpdGxlKHBhc3RlKGVhY2gsICI6IFJhdyB3aXRoIEdBTSIpKSkKICAKICBkYXRhLndvcmtpbmdbZGF0YS53b3JraW5nJFdlaWdodGNsYXNzS2dfQ2FsYyA9PSBlYWNoLCAiVG90YWxLZ19zY2FtIl0gPC0gZGF0YS53b3JraW5nW2RhdGEud29ya2luZyRXZWlnaHRjbGFzc0tnX0NhbGMgPT0gZWFjaCwgIlRvdGFsS2ciXSAvIGRmX3RtcCRzY2FtX3ByZWRpY3QKICAKICBwcmludChnZ3Bsb3QoZGF0YS53b3JraW5nICU+JSBmaWx0ZXIoV2VpZ2h0Y2xhc3NLZ19DYWxjID09IGVhY2gpKSArCiAgICBnZW9tX3BvaW50KGFlcyh4ID0gQm9keXdlaWdodEtnLCB5ID0gVG90YWxLZ19zY2FtKSkgKwogICAgZ2d0aXRsZShwYXN0ZShlYWNoLCAiOiBUcmFuc2Zvcm1lZCIpKSkKfQoKCmdncGxvdChkYXRhLndvcmtpbmcgJT4lIGZpbHRlcihTZXggPT0gIk0iKSkgKwogIGdlb21fcG9pbnQoYWVzKHggPSBCb2R5d2VpZ2h0S2csIHkgPSBUb3RhbEtnX3NjYW0pKQoKZ2dwbG90KGRhdGEud29ya2luZyAlPiUgZmlsdGVyKFNleCA9PSAiRiIpKSArCiAgZ2VvbV9wb2ludChhZXMoeCA9IEJvZHl3ZWlnaHRLZywgeSA9IFRvdGFsS2dfc2NhbSkpCmBgYAoKIyBib3gtY294CmBgYHtyIGJveC1jb3gtdHJhbnNmb3JtfQpib3hfY294X2RmIDwtIG1hdHJpeChuY29sID0gMiwKICAgICAgICAgICAgICAgICAgICAgbnJvdyA9IGxlbmd0aCh1bmlxdWUoZGF0YS53b3JraW5nJFdlaWdodGNsYXNzS2dfQ2FsYykpKQoKIyBkYXRhZnJhbWUgb2Ygb3B0aW1hbCBsYW1iZGFzCmZvciAoeCBpbiAxOmxlbmd0aCh3ZWlnaHRjbGFzc2VzKSl7CiAgdG1wIDwtIGRhdGEud29ya2luZyAlPiUgZmlsdGVyKFdlaWdodGNsYXNzS2dfQ2FsYyA9PSB3ZWlnaHRjbGFzc2VzW3hdKQogIGJveF9jb3hfZGZbeCwxXSA8LSBhcy5jaGFyYWN0ZXIod2VpZ2h0Y2xhc3Nlc1t4XSkKICBib3hfY294X2RmW3gsMl0gPC0gcG93ZXJUcmFuc2Zvcm0odG1wJFRvdGFsS2dfc2NhbSkkbGFtYmRhCn0KCmJveF9jb3hfZGYgPC0gYXMuZGF0YS5mcmFtZShib3hfY294X2RmKQpjb2xuYW1lcyhib3hfY294X2RmKSA8LSBjKCJXZWlnaHRjbGFzc0tnIiwgImxhbWJkYSIpCmJveF9jb3hfZGYkV2VpZ2h0Y2xhc3NLZyA8LSBhcy5jaGFyYWN0ZXIoYm94X2NveF9kZiRXZWlnaHRjbGFzc0tnKQpib3hfY294X2RmJGxhbWJkYSA8LSBhcy5udW1lcmljKGJveF9jb3hfZGYkbGFtYmRhKQpib3hfY294X2RmCgojIGFwcGx5aW5nIGJveC1jb3ggdy8gc2FpZCBvcHRpbWFsIGxhbWJkYQpkYXRhLndvcmtpbmckU0NPUkUgPC0gMApmb3IgKGVhY2ggaW4gd2VpZ2h0Y2xhc3Nlcyl7CiAgeCA9IGRhdGEud29ya2luZ1tkYXRhLndvcmtpbmckV2VpZ2h0Y2xhc3NLZ19DYWxjID09IGVhY2gsIlRvdGFsS2dfc2NhbSJdCiAgZGF0YS53b3JraW5nW2RhdGEud29ya2luZyRXZWlnaHRjbGFzc0tnX0NhbGMgPT0gZWFjaCwiU0NPUkUiXSA8LSBiY1Bvd2VyKHgsYm94X2NveF9kZltib3hfY294X2RmJFdlaWdodGNsYXNzS2cgPT0gZWFjaCwibGFtYmRhIl0pCn0KCgojIGRpdmlkZSBieSBtZWFuCmZvciAoZWFjaCBpbiB3ZWlnaHRjbGFzc2VzKXsKICBkYXRhLndvcmtpbmdbZGF0YS53b3JraW5nJFdlaWdodGNsYXNzS2dfQ2FsYyA9PSBlYWNoLCJTQ09SRSJdIDwtIHNjYWxlKGRhdGEud29ya2luZ1tkYXRhLndvcmtpbmckV2VpZ2h0Y2xhc3NLZ19DYWxjID09IGVhY2gsIlNDT1JFIl0pCn0KYGBgCgoKIyB2aXN1YWxpemUgYm94IGNveCByZXN1bHRzCmBgYHtyIHZpei1ib3gtY294fQojIGluZGl2aWR1YWwgd2VpZ2h0IGNsYXNzZXMKZm9yIChlYWNoIGluIHdlaWdodGNsYXNzZXMpewogIHRtcCA8LSBkYXRhLndvcmtpbmcgJT4lCiAgICBmaWx0ZXIoV2VpZ2h0Y2xhc3NLZ19DYWxjID09IGVhY2gpICU+JQogICAgc2VsZWN0KFNDT1JFKQogIAogIGdnIDwtIGdncGxvdCh0bXApICsKICAgIGdlb21fZGVuc2l0eShhZXMoeCA9IFNDT1JFKSkgKwogICAgZ2d0aXRsZShlYWNoKQogIAogIHByaW50KGdnKQp9CgojIG1hbGUgLyBmZW1hbGUKZm9yIChlYWNoIGluIGMoIk0iLCAiRiIpKXsKICBwcmludChnZ3Bsb3QoZGF0YS53b3JraW5nICU+JSBmaWx0ZXIoU2V4ID09IGVhY2gpKSArCiAgICBnZW9tX3BvaW50KChhZXMoeCA9IEJvZHl3ZWlnaHRLZywgeSA9IFNDT1JFKSkpICsKICAgIGdndGl0bGUocGFzdGUoIkdlbmRlciA9IixlYWNoKSkpCn0KCmBgYAojIFRvcCBNZW4gJiBXb21lbgpgYGB7cn0KZGF0YS53b3JraW5nICU+JQogIGFycmFuZ2UoZGVzYyhTQ09SRSkpICU+JQogIGZpbHRlcihTZXggPT0gIk0iKSAlPiUKICBmaWx0ZXIocm93X251bWJlcigpIDwxMSkKCgpkYXRhLndvcmtpbmcgJT4lCiAgYXJyYW5nZShkZXNjKFNDT1JFKSkgJT4lCiAgZmlsdGVyKFNleCA9PSAiRiIpICU+JQogIGZpbHRlcihyb3dfbnVtYmVyKCkgPDExKQpgYGAKCiMgVmFsaWRhdGlvbjogRGVjaWxlcwpgYGB7cn0KIyB0ZXN0IG91dCBvdGhlciBzY29yZXMuLi4KYGBgCgoK